VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Detail"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 2001                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

'DBAPI constants
Const gkGraphic = 11
Const gkArc = 2
Const gkText = 6
Const gfCosmetic = 128&
                                                                                                                                                                                             
'Useful math constants
Const Pi# = 3.14159265
Const Eps = 0.0001

'Real variant types!
Const typeEmpty = 0
Const typeInteger = 2
Const typeLong = 3
Const typeSingle = 4
Const typeDouble = 5
Const typeCurrency = 6
Const typeDate = 7
Const typeString = 8
Const typeObject = 9
Const typeBoolean = 11
Const typeVariant = 12
Const typeIntegerEnum = typeInteger + 100
Const typeLongEnum = typeLong + 100
Const typeStringEnum = typeString + 100

'Stock property pages
Const ppStockPen = 1
Const ppStockBrush = 2
Const ppStockText = 4
Const ppStockInsert = 8
Const ppStockViewport = 16
Const ppStockAuto = 32

'Property Ids
Const idNutType = 1
Const idDiameter = 2
Const idSolid = 3

Const idNutTypeOld = 4
Const idDiameterOld = 5
Const idSolidOld = 6

Const idHOld = 7

'Property enums


'Number of properties, pages, wizards
Const NUM_PROPERTIES = 7
Const NUM_PAGES = 1
Const NUM_WIZARDS = 0


Private Sub Class_Initialize()
    'Initialize class variables
End Sub

'Returns the user-visible description of this RegenMethod
Public Property Get Description() As String
    Description = "SDK Nut3D"
End Property

'Returns the persistent class id for this RegenMethod's property section
Public Property Get ClassID() As String
    ClassID = "{FDB6F1C3-9631-11d1-A40A-0000B465872B}"
End Property

'Retrieve types and names
Public Function GetPropertyInfo(Names As Variant, Types As Variant, _
    IDs As Variant, Defaults As Variant) As Long
    ReDim Names(NUM_PROPERTIES), Types(NUM_PROPERTIES), _
        IDs(NUM_PROPERTIES), Defaults(NUM_PROPERTIES)
    Names(0) = "NutType"
    Types(0) = typeString
    IDs(0) = idNutType
    Defaults(0) = "HexNut" '"HexSlottedNut"
        
    Names(1) = "Diameter"
    Types(1) = typeDouble
    IDs(1) = idDiameter
    Defaults(1) = 1#

    Names(2) = "NutSolid"
    Types(2) = typeInteger
    IDs(2) = idSolid
    Defaults(2) = 0
    
    Names(3) = "NutTypeOld"
    Types(3) = typeString
    IDs(3) = idNutTypeOld
    Defaults(3) = "HexNut" '"HexSlottedNut"
        
    Names(4) = "DiameterOld"
    Types(4) = typeDouble
    IDs(4) = idDiameterOld
    Defaults(4) = 1.5

    Names(5) = "NutSolidOld"
    Types(5) = typeInteger
    IDs(5) = idSolidOld
    Defaults(5) = 0
   
    Names(6) = "HOld"
    Types(6) = typeDouble
    IDs(6) = idHOld
    Defaults(6) = 0#
   
   GetPropertyInfo = NUM_PROPERTIES
End Function

'Get the number of property pages supporting this RegenMethod
Public Function GetPageInfo(ByVal AGraphic As Object, StockPages As Long, _
    Names As Variant) As Long
    ReDim Names(NUM_PAGES)

    'Need the form
'    Load frmNut3
'    Names(0) = frmNut3.Caption
'    Unload frmNut3
    Names(0) = LoadResString(101)
    StockPages = ppStockBrush + ppStockPen + ppStockAuto
    GetPageInfo = NUM_PAGES
End Function

Public Function GetWizardInfo(Names As Variant) As Long
    ReDim Names(NUM_WIZARDS)
    GetWizardInfo = NUM_WIZARDS
End Function

'Enumerate the names and values of a specified property
Public Function GetEnumNames(ByVal PropID As Long, Names As Variant, Values As Variant) As Long

End Function

Public Function PageControls(ByVal ThisRegenMethod As Object, ByVal Graphic As Object, ByVal PageNumber As Long, ByVal SaveProperties As Boolean) As Boolean
        'Set up error function
        On Error GoTo Failed
        Dim i%
        Dim Diameter#
        Dim SSolid%
        If SaveProperties Then
            'OK button on property page was clicked
            'Form is still loaded
            With frmNut3
                'Need On Error statement for the case where you have
                'RRect Turbo Shape and ahother "shape" selected
                On Error Resume Next
                'When the property page is closed, transfer the numeric
                'Diameter value from the TextBox to the Graphic
                'Get the value as a double-precision number
                TypeN = .List1.Text
                Diameter# = CDbl(.txtdd.Text)
                 If .Surf_Solid.Value = True Then
                    SSolid = False
                 ElseIf .Surf_Solid1.Value = True Then
                    SSolid = True
                 End If
                
                'Set the property values in the Graphic
                Graphic.Properties("Diameter") = Diameter#
                Graphic.Properties("NutType") = TypeN
                Graphic.Properties("NutSolid") = SSolid
                
            End With
        Else
            'Property page is about to be opened
            'Make sure the form is loaded
            Load frmNut3
            With frmNut3
            
                'If more than one RRect is selected and they do not
                'have the same properties, don't set up this field
                On Error GoTo NoRType

                'When the property page is opening, transfer the numeric
                'roundness value from the Graphic to the TextBox
                'Get the roundness property value from the Graphic
                Diameter# = Graphic.Properties("Diameter")
                TypeN = Graphic.Properties("NutType")
                SSolid = Graphic.Properties("NutSolid")
            'Set the TextBox control's text
                .txtdd.Text = Diameter#
                .List1.Text = TypeN
                 If SSolid = True Then
                    .Surf_Solid1.Value = True
                    .Surf_Solid.Value = False
                 ElseIf SSolid = False Then
                    .Surf_Solid1.Value = False
                    .Surf_Solid.Value = True
                 End If

NoRType:
            End With
        End If

        PageControls = True
        Exit Function

Failed:
        'For debugging purposes, report that an error occurred
        If Err.Number <> 0 Then
            MsgBox "Error in PageControls: " & Err.Description
        End If

        'Return false if an error occurred
        PageControls = False
End Function

Public Function PageDone(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant)
        'Done with form
        Unload frmNut3
End Function

Public Function PropertyPages(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant) As Boolean
    With frmNut3
        .Show vbModal
        PropertyPages = Not .DialogCanceled
    End With
End Function

Public Function Wizard(ByVal ThisRegenMethod As Object, Optional WizardNumber As Variant) As Boolean
    Wizard = False
End Function

'Called when vertex has been moved, or other geometry change
Public Function OnGeometryChanged(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant)
    'Do nothing
    'Regen Graphic
End Function

'Called when vertex is moved, or other geometry change
Public Function OnGeometryChanging(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant) As Boolean
    'OK to continue with change
    OnGeometryChanging = True
End Function

Public Function OnNewGraphic(ByVal grfThis1 As Object, ByVal boolCopy As Boolean) As Boolean
    If boolCopy Then
        'Vertices are already added for us...
        OnNewGraphic = True
        Exit Function
    End If
Dim grfThis As Graphic
    Set grfThis = grfThis1
    If grfThis.Application.ActiveDrawing.Properties("TileMode") <> imsiModelSpace Then
        GoTo Failed
    End If
    On Error GoTo Failed
    'New Graphic being created
    'X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable
    'First Vertex is "first point of axis"
    grfThis.Vertices.Add 3#, 5#, 0#
    
    'Second Vertex is "Second point of axis"
    grfThis.Vertices.Add 4#, 5#, 0#, False
    OnNewGraphic = True
    Exit Function

Failed:
    'Return false on failure
    OnNewGraphic = False
End Function

'Function called whenever a copy of a graphic is being made
Public Function OnCopyGraphic(ByVal grfCopy As Object, ByVal grfSource As Object) As Boolean
    'Return false on failure
    OnCopyGraphic = True
End Function

'Notification function called after graphic property is saved
Public Function OnPropertyChanged(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant)
    'Do nothing
End Function

'Notification function called when graphic property is saved
Public Function OnPropertyChanging(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant) As Boolean
    'OK to proceed
    OnPropertyChanging = True
End Function

'Notification function called when graphic property is retrieved
Public Function OnPropertyGet(ByVal Graphic As Object, ByVal PropID As Long)
    'Do nothing
End Function

'Called when we need to update our object
Public Function Regen(ByVal grfThis1 As Object)
'Setup error handler
        On Error GoTo Failed
Dim grfThis As Graphic
        Set grfThis = grfThis1
        'Set up lock (prevent recursion)
        Dim LockCount&
        LockCount& = grfThis.RegenLock
        'Setup error handler (make sure lock is removed)
        On Error GoTo FailedLock
        If LockCount& = 0 Then
Dim TypeNn As String
            'Delete any previous cosmetic children
            TypeNn = grfThis.Properties("NutType")
Dim TypeNOld$
            TypeNOld = grfThis.Properties("NutTypeOld")
Dim dd#, ddOld#
            dd = grfThis.Properties("Diameter")
            ddOld = grfThis.Properties("DiameterOld")
Dim NSolid%, NSolidOld%
            NSolid = grfThis.Properties("NutSolid")
            NSolidOld = grfThis.Properties("NutSolidOld")
Dim Salp#, Calp#, L#
Dim X00#, Y00#, Z00#, X01#, Y01#, Z01#
            grfThis.Vertices.UseWorldCS = True
            With grfThis.Vertices
                X00 = .Item(0).X
                Y00 = .Item(0).Y
                Z00 = .Item(0).Z
                X01 = .Item(1).X
                Y01 = .Item(1).Y
                Z01 = .Item(1).Z
            End With
            
'Block to snap to Bolt's axis
'Dim GrSet As GraphicSet
'Dim CountGr As Long
'Dim i As Long
'Dim Gr1 As Graphic
'Dim X10#, Y10#, Z10#, X11#, Y11#, Z11#
'            Set GrSet = grfThis.Drawing.Graphics.QuerySet("Type=SDK_Bolt_Screw")
'            CountGr = GrSet.Count
'            For i = 0 To CountGr - 1
'                Set Gr1 = GrSet(i)
'                If Gr1.Type = "HexBolt3D.Detail" Then
'                    Gr1.Vertices.UseWorldCS = True
'                    With Gr1.Vertices
'                        X10 = .Item(0).X
'                        Y10 = .Item(0).Y
'                        Z10 = .Item(0).Z
'                        X11 = .Item(1).X
'                        Y11 = .Item(1).Y
'                        Z11 = .Item(1).Z
'                    End With
'Dim s#
'                    s = DistPointLine(X00, Y00, Z00, X10, Y10, Z10, X11, Y11, Z11)
'                    If Abs(s) < -0.1 Then
'Dim hNut#, lBolt#, lBoltNut#
'                        hNut = grfThis.Properties("HOld")
'                        lBolt = Sqr((X11 - X10) * (X11 - X10) + (Y11 - Y10) * (Y11 - Y10) + (Z11 - Z10) * (Z11 - Z10))
'                        lBoltNut = Sqr((X00 - X10) * (X00 - X10) + (Y00 - Y10) * (Y00 - Y10) + (Z00 - Z10) * (Z00 - Z10))
'                        If hNut < Eps Or lBoltNut < Eps Then
'                            Exit For
'                        End If
'Dim X00New#, Y00New#, Z00New#, X01New#, Y01New#, Z01New#
'                        X00New = X10 + (X11 - X10) * lBoltNut / lBolt
'                        Y00New = Y10 + (Y11 - Y10) * lBoltNut / lBolt
'                        Z00New = Z10 + (Z11 - Z10) * lBoltNut / lBolt
'                        X01New = X00New + (X11 - X10) * hNut / lBolt
'                        Y01New = Y00New + (Y11 - Y10) * hNut / lBolt
'                        Z01New = Z00New + (Z11 - Z10) * hNut / lBolt
'                        grfThis.MoveRelative X00New - X00, Y00New - Y00, Z00New - Z00
'Dim xTo#, yTo#, zTo#
'Dim xFrom#, yFrom#, zFrom#
'Dim xRef#, yRef#, zRef#
'                        xRef = X00New
'                        yRef = Y00New
'                        zRef = Z00New

'                        xTo = X00New + (X01 - X00) / hNut
'                        yTo = Y00New + (Y01 - Y00) / hNut
'                        zTo = Z00New + (Z01 - Z00) / hNut

'                        xFrom = X00New + (X01New - X00New) / hNut
'                        yFrom = Y00New + (Y01New - Y00New) / hNut
'                        zFrom = Z00New + (Z01New - Z00New) / hNut
'                        grfThis.RotateAbsolute xTo, yTo, zTo, xFrom, yFrom, zFrom, xRef, yRef, zRef
'                        Salp = (Y01 - Y00) / hNut
'                        Calp = (X01 - X00) / hNut
'Dim beta#
'                        beta = Angle(Salp, Calp)
'
'                       Exit For
'                    End If
'                End If
'            Next i
'            Set Gr1 = Nothing
'            Set GrSet = Nothing

            L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00) + (Z01 - Z00) * (Z01 - Z00))
            Salp = (Y01 - Y00) / L
            Calp = (X01 - X00) / L
 Dim HOld#
            HOld = grfThis.Properties("HOld")
           
'##########################################################
Dim CountCosm As Long, iCosm As Long
            CountCosm = grfThis.Graphics.Count
            If CountCosm > 1 Then
                For iCosm = 1 To CountCosm - 1
                    grfThis.Graphics(iCosm).Properties("PenColor") = grfThis.Properties("PenColor")
                Next iCosm
            End If
            If grfThis.Properties("Selected") = False Or Abs(L - HOld) > Eps Or CountCosm < 2 Or NSolid <> NSolidOld Or Abs(dd - ddOld) > Eps Or TypeNn <> TypeNOld Then
                grfThis.Graphics.Clear gfCosmetic
' Block for Scaling
Dim AddScale#
                AddScale = 1
                dd = dd * AddScale
            
                If TypeNn = "HexNut" Then
                    Call HexNut(grfThis, dd, Salp, Calp, NSolid, AddScale)
                End If
                
                If TypeNn = "HexSlottedNut" Then
                    Call HexSlottedNut(grfThis, dd, Salp, Calp, NSolid, AddScale)
                End If
                
                If TypeNn = "LowCrownNut" Then
                    Call LowCrownNut(grfThis, dd, Salp, Calp, NSolid, AddScale)
                End If
' Block for Unscaling
                dd = dd / AddScale
'Dim Matr As Matrix
                
                grfThis.Properties("DiameterOld") = dd
                grfThis.Properties("NutTypeOld") = TypeNn
                grfThis.Properties("NutSolidOld") = NSolid
                
                grfThis.Vertices.UseWorldCS = True
                With grfThis.Vertices
                    X00 = .Item(0).X
                    Y00 = .Item(0).Y
                    Z00 = .Item(0).Z
                    X01 = .Item(1).X
                    Y01 = .Item(1).Y
                    Z01 = .Item(1).Z
                    L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00) + (Z01 - Z00) * (Z01 - Z00))
                End With
                grfThis.Properties("HOld") = L
            End If
            'Add visible child Graphics
        End If
        grfThis.RegenUnlock
        Exit Function

FailedLock:
        'Remove lock
        grfThis.RegenUnlock

Failed:
End Function

Public Function Draw(ByVal grfThis As Object, ByVal view As Object, Optional mat As Variant) As Boolean
    'Return True if we did the redraw (no further processing necessary, no children will be drawn).
    'Since this is just a test, we return False to let TurboCAD do the drawing operation.
    Draw = False
End Function
Private Function Angle(sinb As Double, cosb As Double) As Double

        If Abs(cosb) < 0.0001 Then
            If sinb > 0 Then
                Angle = Pi / 2
            Else
                Angle = 3 * Pi / 2
            End If
        Else
            If sinb >= 0 And cosb > 0 Then Angle = Atn(sinb / cosb)
            If sinb >= 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb > 0 Then Angle = 2 * Pi + Atn(sinb / cosb)
        End If
End Function




' HexNut

Private Sub HexNut(Gr As Graphic, dd As Double, Salp As Double, Calp As Double, SSolid As Integer, AddScale As Double)
On Error GoTo Failed
Dim Grs As Graphics
    Set Grs = Gr.Application.ActiveDrawing.Graphics
Dim D#, H#, s#, del#
        D = 1.84 * dd
        H = 0.7 * dd
        s = D * Cos(Pi / 6)
        del = 0.1 * dd
        
        Gr.Vertices.UseWorldCS = True
        
Dim X00#, Y00#, Z00#, X01#, Y01#, Z01#, L#
        
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            Z00 = .Item(0).Z
            X01 = .Item(1).X
            Y01 = .Item(1).Y
            Z01 = .Item(1).Z
            L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00) + (Z01 - Z00) * (Z01 - Z00)) '!!!!!!!
            .Item(1).X = X00 + (X01 - X00) * H / AddScale / L
            .Item(1).Y = Y00 + (Y01 - Y00) * H / AddScale / L
            .Item(1).Z = Z00 + (Z01 - Z00) * H / AddScale / L
            X01 = X00 + (X01 - X00) * H / L '!!!!!!!
            Y01 = Y00 + (Y01 - Y00) * H / L '!!!!!!!
            Z01 = Z00 + (Z01 - Z00) * H / L '!!!!!!!
        End With

        
Dim X00New#, Y00New#, Z00New#, X01New#, Y01New#, Z01New#
        X00New = X00    '!!!!!!!
        Y00New = Y00    '!!!!!!!
        Z00New = Z00    '!!!!!!!
        X01New = X01    '!!!!!!!
        Y01New = Y01    '!!!!!!!
        Z01New = Z01    '!!!!!!!
        X00 = 0#    '!!!!!!!
        Y00 = 0#    '!!!!!!!
        Z00 = 0#    '!!!!!!!
        X01 = H    '!!!!!!!
        Y01 = 0#    '!!!!!!!
        Z01 = 0#    '!!!!!!!
        
Dim x0(100)
Dim y0(100)
Dim X(100)
Dim Y(100)
       

Dim i As Long
' Head of the bolt
    For i = 7 To 13
        x0(i) = D / 2 * Cos(Pi / 3 * (i - 7))
        y0(i) = D / 2 * Sin(Pi / 3 * (i - 7))
    Next i
Dim Gr1 As Graphic
Set Gr1 = Grs.Add(gkGraphic)
Gr1.Vertices.UseWorldCS = True
With Gr1.Vertices
    For i = 7 To 13
        .Add x0(i), y0(i), 0
    Next i
End With
Gr1.Closed = True
Gr1.Properties("Thickness") = H
Gr1.Properties("Solid") = SSolid
Dim xTo#, yTo#, zTo#, xFrom#, yFrom#, zFrom#, xRef#, yRef#, zRef#
    xTo = X00 + (X01 - X00) / H
    yTo = Y00 + (Y01 - Y00) / H
    zTo = 0
    xFrom = X00
    yFrom = Y00
    zFrom = -1#
    xRef = X00
    yRef = Y00
    zRef = 0#
    Gr1.RotateAbsolute xTo, yTo, zTo, xFrom, yFrom, zFrom, xRef, yRef, zRef
    Gr1.Draw
'################################################################
'################################################################
Dim T#
    T = D / 2 * Sin(Pi / 3)
       x0(1) = -0.1 * H
       y0(1) = T * 0.7 - 0.1 * H / Tan(Pi / 6)
       
       x0(2) = -0.1 * H
       y0(2) = D
       
       x0(3) = 0.4 * H
       y0(3) = D
       
       x0(4) = 0.4 * H
       y0(4) = T * 0.7 + 0.5 * H / Tan(Pi / 6)
       
       x0(5) = x0(1)
       y0(5) = y0(1)
       
'-----------------------------------------------------------
       
Dim GrTemp As Graphic
            Set GrTemp = Grs.Add(gkGraphic)
GrTemp.Vertices.UseWorldCS = True
            With GrTemp.Vertices
                For i = 1 To 5
                    .Add x0(i), y0(i), 0
                Next i
            End With
            GrTemp.Closed = True
Dim Gr2 As Graphic '1 faska
            Set Gr2 = Grs.Add(, "TCW40SPIN")
Gr2.Vertices.UseWorldCS = True
            Gr2.Properties("Solid") = SSolid
            Gr2.Properties("$ROTATIONANGLE") = 2 * Pi
            Gr2.Properties("$ROTATIONCOPY") = 30
            Set GrTemp = Grs.Remove(GrTemp.Index)
            Gr2.Graphics.AddGraphic GrTemp
            Gr2.Vertices.Add X00, Y00, 0
            Gr2.Vertices.Add X01, Y01, 0
            Gr2.Draw
Dim Gr3 As Graphic ' 2 faska
            Set Gr3 = Gr2.Duplicate
            Gr3.RotateAxis Pi, 0, 0, 1, X00, Y00, Z00
            Gr3.MoveRelative H, 0, 0
            Gr3.Draw
' Internal Hole
       x0(1) = -del
       y0(1) = 0#
       
       x0(2) = -del
       y0(2) = dd / 2 + del
       
       x0(3) = del
       y0(3) = dd / 2 - del
       
       x0(4) = H - del
       y0(4) = dd / 2 - del
       
       x0(5) = H + del
       y0(5) = dd / 2 + del
       
       x0(6) = H + del
       y0(6) = 0
       
       x0(7) = x0(1)
       y0(7) = y0(1)
       
'-----------------------------------------------------------
       
            Set GrTemp = Grs.Add(gkGraphic)
GrTemp.Vertices.UseWorldCS = True
            With GrTemp.Vertices
                For i = 1 To 7
                    .Add x0(i), y0(i), 0
                Next i
            End With
            GrTemp.Closed = True
Dim Gr4 As Graphic
            Set Gr4 = Grs.Add(, "TCW40SPIN")
Gr4.Vertices.UseWorldCS = True
            Gr4.Properties("Solid") = SSolid
            Gr4.Properties("$ROTATIONANGLE") = 2 * Pi
            Gr4.Properties("$ROTATIONCOPY") = 30
            Set GrTemp = Grs.Remove(GrTemp.Index)
            Gr4.Graphics.AddGraphic GrTemp
            Gr4.Vertices.Add X00, Y00, 0, False, False, False, False, False
            Gr4.Vertices.Add X01, Y01, 0, False, False, False, False, False
            Gr4.Draw
' Thread
    'Base contour
Dim hThread# ' Step of the thread
    hThread = del / Sin(Pi / 3)
Dim nCoil As Long
    nCoil = 10
    nCoil = CLng(H / hThread) + 2
Dim lThread#
    lThread = nCoil * hThread
Dim k As Long
    
    x0(1) = 0 '  hThread
    y0(1) = 0#
    
    x0(2) = 0 '  hThread
    y0(2) = dd / 2 - del
    
    k = 2
    
    For i = 1 To nCoil
        k = k + 1
        x0(k) = x0(k - 1) + hThread / 2
        y0(k) = y0(k - 1) + del
        k = k + 1
        x0(k) = x0(k - 1) + hThread / 2
        y0(k) = y0(k - 1) - del
    Next i
    k = k + 1
    x0(k) = x0(k - 1)
    y0(k) = 0
    
    k = k + 1
    x0(k) = 0
    y0(k) = 0

Set GrTemp = Grs.Add(gkGraphic)
GrTemp.Vertices.UseWorldCS = True
With GrTemp.Vertices
    For i = 1 To k '6
        .Add x0(i), y0(i), 0
    Next i
End With
GrTemp.Closed = True
GrTemp.MoveRelative -hThread, 0, 0
GrTemp.Draw
Dim Gr5 As Graphic
Set Gr5 = Grs.Add(, "TCW40SPIN")
Gr5.Vertices.UseWorldCS = True
Gr5.Properties("Solid") = SSolid
Gr5.Properties("$ROTATIONANGLE") = 2 * Pi
Gr5.Properties("$ROTATIONCOPY") = 30
Set GrTemp = Grs.Remove(GrTemp.Index)
Gr5.Graphics.AddGraphic GrTemp
Gr5.Vertices.Add X00, Y00, 0, False, False, False, False, False
Gr5.Vertices.Add X01, Y01, 0, False, False, False, False, False
Gr5.Draw

'#################################################################
'################################################################
Dim Bool3D As Boolean3D
Dim GrRes1 As Graphic
Dim GrIndex As Long
    Set Bool3D = New Boolean3D
'    Gr1.Draw
'    Gr2.Draw
'MsgBox ("1111")
    Set GrRes1 = Bool3D.Subtract(Gr1, Gr2)
'MsgBox (GrRes1.Type)
    If (Not GrRes1 Is Nothing) Then
        Gr1.Visible = False
        Gr1.Draw
        Gr1.Deleted = True
        Gr2.Visible = False
        Gr2.Draw
        Gr2.Deleted = True
        Grs.AddGraphic GrRes1
'MsgBox ("@@@@")
    Else
        GrIndex = Gr2.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr2
        Gr2.Cosmetic = True
        Set GrRes1 = Gr1
    End If
Dim GrRes2 As Graphic
    GrRes1.Draw
    Set GrRes2 = Bool3D.Subtract(GrRes1, Gr3)
    If (Not GrRes2 Is Nothing) Then
        GrRes1.Visible = False
        GrRes1.Draw
        GrRes1.Deleted = True
        Gr3.Visible = False
        Gr3.Draw
        Gr3.Deleted = True
        Grs.AddGraphic GrRes2
    Else
        GrIndex = Gr3.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr3
        Gr3.Cosmetic = True
        Set GrRes2 = GrRes1
    End If
    
Dim GrRes3 As Graphic
    GrRes2.Draw
    Set GrRes3 = Bool3D.Subtract(GrRes2, Gr4)
    If (Not GrRes3 Is Nothing) Then
        GrRes2.Visible = False
        GrRes2.Draw
        GrRes2.Deleted = True
        Gr4.Visible = False
        Gr4.Draw
        Gr4.Deleted = True
        Grs.AddGraphic GrRes3
    Else
        GrIndex = Gr4.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr4
        Gr4.Cosmetic = True
        Set GrRes3 = GrRes2
    End If
    
Dim GrRes4 As Graphic
    GrRes3.Draw
'MsgBox ("111")
    Set GrRes4 = Bool3D.Subtract(GrRes3, Gr5)
    
    If (Not GrRes4 Is Nothing) Then
        GrRes3.Visible = False
        GrRes3.Draw
        GrRes3.Deleted = True
        Gr5.Visible = False
        Gr5.Draw
        Gr5.Deleted = True
        Grs.AddGraphic GrRes4
        GrRes4.Draw
Dim Matr As Matrix
       
        GrIndex = GrRes4.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic GrRes4
        GrRes4.Cosmetic = True
        GrRes4.Properties("PenColor") = Gr.Properties("PenColor")
        
'????????????????????????????????????????????????????????????????
Dim GrLine As Graphic
        Set GrLine = Grs.Add(11)
        GrLine.Vertices.UseWorldCS = True
        With GrLine.Vertices
            .Add 0, 0, 0
            .Add H, 0, 0
        End With
        GrIndex = GrLine.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic GrLine
        GrLine.Cosmetic = True
Dim xx0#, yy0#, zz0#, xx1#, yy1#, zz1#
        GrLine.Vertices.UseWorldCS = False
        With GrLine.Vertices
            xx0 = .Item(0).X
            yy0 = .Item(0).Y
            zz0 = .Item(0).Z
            xx1 = .Item(1).X
            yy1 = .Item(1).Y
            zz1 = .Item(1).Z
        End With
         Gr.Vertices.UseWorldCS = False
        With Gr.Vertices
            X00New = .Item(0).X
            Y00New = .Item(0).Y
            Z00New = .Item(0).Z
        End With
        GrRes4.MoveRelative X00New - xx0, Y00New - yy0, Z00New - zz0 '!!!!!!!
        GrLine.Deleted = True
'????????????????????????????????????????????????????????????????
        
    Else
        GrIndex = Gr5.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr5
        Gr5.Cosmetic = True
        
        Set GrRes4 = GrRes3
        GrIndex = GrRes4.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic GrRes4
        GrRes4.Cosmetic = True
    
    End If
    
    Set Gr1 = Nothing
    Set Gr2 = Nothing
    Set Gr3 = Nothing
    Set Gr4 = Nothing
    Set Gr5 = Nothing
    Set GrRes1 = Nothing
    Set GrRes2 = Nothing
    Set GrRes3 = Nothing
    Set GrRes4 = Nothing
    Set GrTemp = Nothing
    Set Grs = Nothing
    Set Bool3D = Nothing
    
Exit Sub
Failed:
End Sub

' HexSlottedNut

Private Sub HexSlottedNut(Gr As Graphic, dd As Double, Salp As Double, Calp As Double, SSolid As Integer, AddScale As Double)
On Error GoTo Failed
Dim Grs As Graphics
    Set Grs = Gr.Application.ActiveDrawing.Graphics
Dim D#, H#, s#, del#
        D = 1.84 * dd
        H = 1# * dd
        s = D * Cos(Pi / 6)
        del = 0.1 * dd
Dim J#
        J = 0.2 * dd
        Gr.Vertices.UseWorldCS = True
        
Dim X00#, Y00#, Z00#, X01#, Y01#, Z01#, L#
        
       With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            Z00 = .Item(0).Z
            X01 = .Item(1).X
            Y01 = .Item(1).Y
            Z01 = .Item(1).Z
            L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00) + (Z01 - Z00) * (Z01 - Z00)) '!!!!!!!
            .Item(1).X = X00 + (X01 - X00) * H / AddScale / L
            .Item(1).Y = Y00 + (Y01 - Y00) * H / AddScale / L
            .Item(1).Z = Z00 + (Z01 - Z00) * H / AddScale / L
            X01 = X00 + (X01 - X00) * H / L '!!!!!!!
            Y01 = Y00 + (Y01 - Y00) * H / L '!!!!!!!
            Z01 = Z00 + (Z01 - Z00) * H / L '!!!!!!!
        End With

        
Dim X00New#, Y00New#, Z00New#, X01New#, Y01New#, Z01New#
        X00New = X00    '!!!!!!!
        Y00New = Y00    '!!!!!!!
        Z00New = Z00    '!!!!!!!
        X01New = X01    '!!!!!!!
        Y01New = Y01    '!!!!!!!
        Z01New = Z01    '!!!!!!!
        X00 = 0#    '!!!!!!!
        Y00 = 0#    '!!!!!!!
        Z00 = 0#    '!!!!!!!
        X01 = H    '!!!!!!!
        Y01 = 0#    '!!!!!!!
        Z01 = 0#    '!!!!!!!
         
        
Dim x0(100)
Dim y0(100)
Dim X(100)
Dim Y(100)
       

Dim i As Long
' Head of the bolt
    For i = 7 To 13
        x0(i) = D / 2 * Cos(Pi / 3 * (i - 7))
        y0(i) = D / 2 * Sin(Pi / 3 * (i - 7))
    Next i
Dim Gr1 As Graphic
Set Gr1 = Grs.Add(gkGraphic)
Gr1.Vertices.UseWorldCS = True
With Gr1.Vertices
    For i = 7 To 13
        .Add x0(i), y0(i), 0, True, True, False, False, False, False
    Next i
End With
Gr1.Closed = True
Gr1.Properties("Thickness") = H
Gr1.Properties("Solid") = SSolid
Dim xTo#, yTo#, zTo#, xFrom#, yFrom#, zFrom#, xRef#, yRef#, zRef#
    xTo = X00 + (X01 - X00) / H
    yTo = Y00 + (Y01 - Y00) / H
    zTo = 0
    xFrom = X00
    yFrom = Y00
    zFrom = -1#
    xRef = X00
    yRef = Y00
    zRef = 0#
    Gr1.RotateAbsolute xTo, yTo, zTo, xFrom, yFrom, zFrom, xRef, yRef, zRef
    Gr1.Draw
'################################################################
'################################################################
Dim T#
    T = D / 2 * Sin(Pi / 3)
       x0(1) = -0.1 * H
       y0(1) = T * 0.7 - 0.1 * H / Tan(Pi / 6)
       
       x0(2) = -0.1 * H
       y0(2) = D
       
       x0(3) = 0.4 * H
       y0(3) = D
       
       x0(4) = 0.4 * H
       y0(4) = T * 0.7 + 0.5 * H / Tan(Pi / 6)
       
       x0(5) = x0(1)
       y0(5) = y0(1)
       
'-----------------------------------------------------------
       
Dim GrTemp As Graphic
            Set GrTemp = Grs.Add(gkGraphic)
            GrTemp.Vertices.UseWorldCS = True
            With GrTemp.Vertices
                For i = 1 To 5
                    .Add x0(i), y0(i), 0
                Next i
            End With
            GrTemp.Closed = True
            GrTemp.Draw
Dim Gr2 As Graphic '1 faska
            Set Gr2 = Grs.Add(, "TCW40SPIN")
            Gr2.Vertices.UseWorldCS = True
            Gr2.Properties("Solid") = SSolid
            Gr2.Properties("$ROTATIONANGLE") = 2 * Pi
            Gr2.Properties("$ROTATIONCOPY") = 30
            Set GrTemp = Grs.Remove(GrTemp.Index)
            Gr2.Graphics.AddGraphic GrTemp
            Gr2.Vertices.Add X00, Y00, 0, False, False, False, False, False
            Gr2.Vertices.Add X01, Y01, 0, False, False, False, False, False
            Gr2.Draw
Dim Gr3 As Graphic ' 2 faska
            Set Gr3 = Gr2.Duplicate
            Gr3.RotateAxis Pi, 0, 0, 1, X00, Y00, Z00
            Gr3.MoveRelative H, 0, 0
            Gr3.Draw
' Internal Hole
       x0(1) = -del
       y0(1) = 0#
       
       x0(2) = -del
       y0(2) = dd / 2 + del
       
       x0(3) = del
       y0(3) = dd / 2 - del
       
       x0(4) = H - del
       y0(4) = dd / 2 - del
       
       x0(5) = H + del
       y0(5) = dd / 2 + del
       
       x0(6) = H + del
       y0(6) = 0
       
       x0(7) = x0(1)
       y0(7) = y0(1)
       
'-----------------------------------------------------------
       
            Set GrTemp = Grs.Add(gkGraphic)
            GrTemp.Vertices.UseWorldCS = True
            With GrTemp.Vertices
                For i = 1 To 7
                    .Add x0(i), y0(i), 0
                Next i
            End With
            GrTemp.Closed = True
Dim Gr4 As Graphic
            Set Gr4 = Grs.Add(, "TCW40SPIN")
            Gr4.Vertices.UseWorldCS = True
            Gr4.Properties("Solid") = SSolid
            Gr4.Properties("$ROTATIONANGLE") = 2 * Pi
            Gr4.Properties("$ROTATIONCOPY") = 30
            Set GrTemp = Grs.Remove(GrTemp.Index)
            Gr4.Graphics.AddGraphic GrTemp
            Gr4.Vertices.Add X00, Y00, 0, False, False, False, False, False
            Gr4.Vertices.Add X01, Y01, 0, False, False, False, False, False
            Gr4.Draw

' Thread
    'Base contour
Dim hThread# ' Step of the thread
    hThread = del / Sin(Pi / 3)
Dim nCoil As Long
    nCoil = 10
    nCoil = CLng(H / hThread) + 3
Dim lThread#
    lThread = nCoil * hThread
Dim k As Long
    
    x0(1) = 0#
    y0(1) = 0#
    
    x0(2) = 0#
    y0(2) = dd / 2 - del
    
    k = 2
    
    For i = 1 To nCoil
        k = k + 1
        x0(k) = x0(k - 1) + hThread / 2
        y0(k) = y0(k - 1) + del
        k = k + 1
        x0(k) = x0(k - 1) + hThread / 2
        y0(k) = y0(k - 1) - del
    Next i
    k = k + 1
    x0(k) = x0(k - 1)
    y0(k) = 0
    
    k = k + 1
    x0(k) = 0
    y0(k) = 0


Set GrTemp = Grs.Add(gkGraphic)
GrTemp.Vertices.UseWorldCS = True
With GrTemp.Vertices
    For i = 1 To k '6
        .Add x0(i), y0(i), 0
    Next i
End With
GrTemp.Closed = True
GrTemp.MoveRelative -hThread, 0, 0
GrTemp.Draw

Dim Gr5 As Graphic
Set Gr5 = Grs.Add(, "TCW40SPIN")
Gr5.Vertices.UseWorldCS = True
Gr5.Properties("Solid") = SSolid
Gr5.Properties("$ROTATIONANGLE") = 2 * Pi
Gr5.Properties("$ROTATIONCOPY") = 30
Set GrTemp = Grs.Remove(GrTemp.Index)
Gr5.Graphics.AddGraphic GrTemp
Gr5.Vertices.Add X00, Y00, 0, False, False, False, False, False
Gr5.Vertices.Add X01, Y01, 0, False, False, False, False, False
Gr5.Draw

' First Slot
Dim fi#, dfi#
    dfi = Pi / 9#
    x0(1) = H + 0.1 * J
    y0(1) = -J / 2
    
    x0(2) = H + 0.1 * J
    y0(2) = J / 2
    
    x0(3) = x0(1) - J
    y0(3) = J / 2
    
    For i = 1 To 8
        x0(i + 3) = x0(3) + J / 2 * Cos(Pi / 2# + i * dfi)
        y0(i + 3) = J / 2 * Sin(Pi / 2# - i * dfi)
    Next i
    
    x0(12) = x0(3)
    y0(12) = -J / 2
    
    x0(13) = x0(1)
    y0(13) = y0(1)
    
Dim Gr6 As Graphic
    Set Gr6 = Grs.Add(gkGraphic)
    Gr6.Vertices.UseWorldCS = True
    With Gr6.Vertices
        For i = 1 To 13
            .Add x0(i), y0(i), 0
        Next i
    End With
    Gr6.Closed = True
    Gr6.MoveRelative 0, 0, -D
    Gr6.Properties("Thickness") = 2 * D
    Gr6.Properties("Solid") = SSolid
        
Dim dx#, dy#
    L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00) + (Z01 - Z00) * (Z01 - Z00))
    dx = (X01 - X00) / L
    dy = (Y01 - Y00) / L
    Gr6.RotateAxis Pi / 6, dx, dy, 0, X00, Y00, Z00
    Gr6.Draw
    
Dim Gr7 As Graphic
    Set Gr7 = Gr6.Duplicate
    Gr7.RotateAxis Pi / 3, dx, dy, 0, X00, Y00, Z00
    Gr7.Draw
    
Dim Gr8 As Graphic
    Set Gr8 = Gr7.Duplicate
    Gr8.RotateAxis Pi / 3, dx, dy, 0, X00, Y00, Z00
    Gr8.Draw
'MsgBox ("1111")
'#################################################################
'################################################################
Dim Bool3D As Boolean3D
Dim GrRes1 As Graphic
Dim GrIndex As Long
    Set Bool3D = New Boolean3D
    Gr1.Draw
    Gr2.Draw
    Set GrRes1 = Bool3D.Subtract(Gr1, Gr2)
    If (Not GrRes1 Is Nothing) Then
        Gr1.Visible = False
        Gr1.Draw
        Gr1.Deleted = True
        Gr2.Visible = False
        Gr2.Draw
        Gr2.Deleted = True
        Grs.AddGraphic GrRes1
    Else
        GrIndex = Gr2.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr2
        Gr2.Cosmetic = True
        Set GrRes1 = Gr1
    End If
Dim GrRes2 As Graphic
    GrRes1.Draw
    Set GrRes2 = Bool3D.Subtract(GrRes1, Gr3)
    If (Not GrRes2 Is Nothing) Then
        GrRes1.Visible = False
        GrRes1.Draw
        GrRes1.Deleted = True
        Gr3.Visible = False
        Gr3.Draw
        Gr3.Deleted = True
        Grs.AddGraphic GrRes2
    Else
        GrIndex = Gr3.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr3
        Gr3.Cosmetic = True
        Set GrRes2 = GrRes1
    End If
    
Dim GrRes3 As Graphic
    GrRes2.Draw
    Set GrRes3 = Bool3D.Subtract(GrRes2, Gr4)
    If (Not GrRes3 Is Nothing) Then
        GrRes2.Visible = False
        GrRes2.Draw
        GrRes2.Deleted = True
        Gr4.Visible = False
        Gr4.Draw
        Gr4.Deleted = True
        Grs.AddGraphic GrRes3
    Else
        GrIndex = Gr4.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr4
        Gr4.Cosmetic = True
        Set GrRes3 = GrRes2
    End If
    
' Work with slots
Dim GrRes5 As Graphic
    GrRes3.Draw
    Set GrRes5 = Bool3D.Subtract(GrRes3, Gr6)
    If (Not GrRes5 Is Nothing) Then
        GrRes3.Visible = False
        GrRes3.Draw
        GrRes3.Deleted = True
        Gr6.Visible = False
        Gr6.Draw
        Gr6.Deleted = True
        Grs.AddGraphic GrRes5
    Else
        GrIndex = Gr6.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr6
        Gr6.Cosmetic = True
        Set GrRes5 = GrRes3
    End If
    
Dim GrRes6 As Graphic
    GrRes5.Draw
    Set GrRes6 = Bool3D.Subtract(GrRes5, Gr7)
    If (Not GrRes6 Is Nothing) Then
        GrRes5.Visible = False
        GrRes5.Draw
        GrRes5.Deleted = True
        Gr7.Visible = False
        Gr7.Draw
        Gr7.Deleted = True
        Grs.AddGraphic GrRes6
    Else
        GrIndex = Gr7.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr7
        Gr7.Cosmetic = True
        Set GrRes6 = GrRes5
    End If
    
Dim GrRes7 As Graphic
    GrRes6.Draw
    Set GrRes7 = Bool3D.Subtract(GrRes6, Gr8)
    If (Not GrRes7 Is Nothing) Then
        GrRes6.Visible = False
        GrRes6.Draw
        GrRes6.Deleted = True
        Gr8.Visible = False
        Gr8.Draw
        Gr8.Deleted = True
        Grs.AddGraphic GrRes7
    Else
        GrIndex = Gr8.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr8
        Gr8.Cosmetic = True
        Set GrRes7 = GrRes6
    End If

' End with slots
Dim GrRes4 As Graphic
    GrRes7.Draw
    Set GrRes4 = Bool3D.Subtract(GrRes7, Gr5)
    If (Not GrRes4 Is Nothing) Then
        GrRes7.Visible = False
        GrRes7.Draw
        GrRes7.Deleted = True
        Gr5.Visible = False
        Gr5.Draw
        Gr5.Deleted = True
        Grs.AddGraphic GrRes4
Dim Matr As Matrix
        GrIndex = GrRes4.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic GrRes4
        GrRes4.Cosmetic = True
        GrRes4.Properties("PenColor") = Gr.Properties("PenColor")
'????????????????????????????????????????????????????????????????
Dim GrLine As Graphic
        Set GrLine = Grs.Add(11)
        GrLine.Vertices.UseWorldCS = True
        With GrLine.Vertices
            .Add 0, 0, 0
            .Add H, 0, 0
        End With
        GrIndex = GrLine.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic GrLine
        GrLine.Cosmetic = True
Dim xx0#, yy0#, zz0#, xx1#, yy1#, zz1#
        GrLine.Vertices.UseWorldCS = False
        With GrLine.Vertices
            xx0 = .Item(0).X
            yy0 = .Item(0).Y
            zz0 = .Item(0).Z
            xx1 = .Item(1).X
            yy1 = .Item(1).Y
            zz1 = .Item(1).Z
        End With
         Gr.Vertices.UseWorldCS = False
        With Gr.Vertices
            X00New = .Item(0).X
            Y00New = .Item(0).Y
            Z00New = .Item(0).Z
        End With
        GrRes4.MoveRelative X00New - xx0, Y00New - yy0, Z00New - zz0 '!!!!!!!
        GrLine.Deleted = True
'????????????????????????????????????????????????????????????????
    Else
        GrIndex = Gr5.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr5
        Gr5.Cosmetic = True
        
        Set GrRes4 = GrRes5
        GrIndex = GrRes4.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic GrRes4
        GrRes4.Cosmetic = True
    
    End If

    Set Gr1 = Nothing
    Set Gr2 = Nothing
    Set Gr3 = Nothing
    Set Gr4 = Nothing
    Set Gr5 = Nothing
    Set Gr6 = Nothing
    Set Gr7 = Nothing
    Set Gr8 = Nothing
    Set GrRes1 = Nothing
    Set GrRes2 = Nothing
    Set GrRes3 = Nothing
    Set GrRes4 = Nothing
    Set GrRes5 = Nothing
    Set GrRes6 = Nothing
    Set GrRes7 = Nothing
    Set GrTemp = Nothing
    Set Grs = Nothing
    Set Bool3D = Nothing
    
Exit Sub
Failed:
End Sub


' LowCrownNut

Private Sub LowCrownNut(Gr As Graphic, dd As Double, Salp As Double, Calp As Double, SSolid As Integer, AddScale As Double)
On Error GoTo Failed
Dim Grs As Graphics
    Set Grs = Gr.Application.ActiveDrawing.Graphics
Dim D#, H#, s#, del#
        D = 1.84 * dd
        H = 0.7 * dd
        s = D * Cos(Pi / 6)
        del = 0.1 * dd
        
        Gr.Vertices.UseWorldCS = True
        
Dim X00#, Y00#, Z00#, X01#, Y01#, Z01#, L#
        
       With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            Z00 = .Item(0).Z
            X01 = .Item(1).X
            Y01 = .Item(1).Y
            Z01 = .Item(1).Z
            L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00) + (Z01 - Z00) * (Z01 - Z00)) '!!!!!!!
            .Item(1).X = X00 + (X01 - X00) * H / AddScale / L
            .Item(1).Y = Y00 + (Y01 - Y00) * H / AddScale / L
            .Item(1).Z = Z00 + (Z01 - Z00) * H / AddScale / L
            X01 = X00 + (X01 - X00) * H / L '!!!!!!!
            Y01 = Y00 + (Y01 - Y00) * H / L '!!!!!!!
            Z01 = Z00 + (Z01 - Z00) * H / L '!!!!!!!
        End With
        
Dim X00New#, Y00New#, Z00New#, X01New#, Y01New#, Z01New#
        X00New = X00    '!!!!!!!
        Y00New = Y00    '!!!!!!!
        Z00New = Z00    '!!!!!!!
        X01New = X01    '!!!!!!!
        Y01New = Y01    '!!!!!!!
        Z01New = Z01    '!!!!!!!
        X00 = 0#    '!!!!!!!
        Y00 = 0#    '!!!!!!!
        Z00 = 0#    '!!!!!!!
        X01 = H    '!!!!!!!
        Y01 = 0#    '!!!!!!!
        Z01 = 0#    '!!!!!!!
        
Dim x0(100)
Dim y0(100)
Dim X(100)
Dim Y(100)

Dim i As Long
' Head of the bolt
    For i = 7 To 13
        x0(i) = D / 2 * Cos(Pi / 3 * (i - 7))
        y0(i) = D / 2 * Sin(Pi / 3 * (i - 7))
    Next i
Dim Gr1 As Graphic
Set Gr1 = Grs.Add(gkGraphic)
Gr1.Vertices.UseWorldCS = True
With Gr1.Vertices
    For i = 7 To 13
        .Add x0(i), y0(i), 0, True, True, False, False, False, False
    Next i
End With
Gr1.Closed = True
Gr1.Properties("Thickness") = H
Gr1.Properties("Solid") = SSolid
Dim xTo#, yTo#, zTo#, xFrom#, yFrom#, zFrom#, xRef#, yRef#, zRef#
    xTo = X00 + (X01 - X00) / H
    yTo = Y00 + (Y01 - Y00) / H
    zTo = 0
    xFrom = X00
    yFrom = Y00
    zFrom = -1#
    xRef = X00
    yRef = Y00
    zRef = 0#
    Gr1.RotateAbsolute xTo, yTo, zTo, xFrom, yFrom, zFrom, xRef, yRef, zRef
'################################################################
'################################################################
Dim T#
    T = D / 2 * Sin(Pi / 3)
       x0(1) = -0.1 * H
       y0(1) = T * 0.7 - 0.1 * H / Tan(Pi / 6)
       
       x0(2) = -0.1 * H
       y0(2) = D
       
       x0(3) = 0.4 * H
       y0(3) = D
       
       x0(4) = 0.4 * H
       y0(4) = T * 0.7 + 0.5 * H / Tan(Pi / 6)
       
       x0(5) = x0(1)
       y0(5) = y0(1)
       
'-----------------------------------------------------------
       
Dim GrTemp As Graphic
            Set GrTemp = Grs.Add(gkGraphic)
            GrTemp.Vertices.UseWorldCS = True
            With GrTemp.Vertices
                For i = 1 To 5
                    .Add x0(i), y0(i), 0
                Next i
            End With
            GrTemp.Closed = True
Dim Gr2 As Graphic '1 faska
            Set Gr2 = Grs.Add(, "TCW40SPIN")
            Gr2.Vertices.UseWorldCS = True
            Gr2.Properties("Solid") = SSolid
            Gr2.Properties("$ROTATIONANGLE") = 2 * Pi
            Gr2.Properties("$ROTATIONCOPY") = 30
            Set GrTemp = Grs.Remove(GrTemp.Index)
            Gr2.Graphics.AddGraphic GrTemp
            Gr2.Vertices.Add X00, Y00, 0, False, False, False, False, False
            Gr2.Vertices.Add X01, Y01, 0, False, False, False, False, False
Dim Gr3 As Graphic ' 2 faska
            Set Gr3 = Gr2.Duplicate
            Gr3.RotateAxis Pi, 0, 0, 1, X00, Y00, Z00
            Gr3.MoveRelative H, 0, 0

' Internal Hole
       x0(1) = -del
       y0(1) = 0#
       
       x0(2) = -del
       y0(2) = dd / 2 + del
       
       x0(3) = del
       y0(3) = dd / 2 - del
       
       x0(4) = 1.3 * H - del
       y0(4) = dd / 2 - del
       
       x0(5) = 1.3 * H + del
       y0(5) = dd / 2 + del
       
       x0(6) = 1.3 * H + del
       y0(6) = 0
       
       x0(7) = x0(1)
       y0(7) = y0(1)
       
'-----------------------------------------------------------
       
            Set GrTemp = Grs.Add(gkGraphic)
            GrTemp.Vertices.UseWorldCS = True
            With GrTemp.Vertices
                For i = 1 To 7
                    .Add x0(i), y0(i), 0
                Next i
            End With
            GrTemp.Closed = True
Dim Gr4 As Graphic
            Set Gr4 = Grs.Add(, "TCW40SPIN")
            Gr4.Vertices.UseWorldCS = True
            Gr4.Properties("Solid") = SSolid
            Gr4.Properties("$ROTATIONANGLE") = 2 * Pi
            Gr4.Properties("$ROTATIONCOPY") = 30
            Set GrTemp = Grs.Remove(GrTemp.Index)
            Gr4.Graphics.AddGraphic GrTemp
            Gr4.Vertices.Add X00, Y00, 0, False, False, False, False, False
            Gr4.Vertices.Add X01, Y01, 0, False, False, False, False, False


' Thread
    'Base contour
Dim hThread# ' Step of the thread
    hThread = del / Sin(Pi / 3)
Dim nCoil As Long
    nCoil = 10
    nCoil = CLng(H / hThread) + 2
    
Dim lThread#
    lThread = nCoil * hThread
Dim k As Long
    
    x0(1) = 0#
    y0(1) = 0#
    
    x0(2) = 0#
    y0(2) = dd / 2 - del
    
    k = 2
    
    For i = 1 To nCoil
        k = k + 1
        x0(k) = x0(k - 1) + hThread / 2
        y0(k) = y0(k - 1) + del
        k = k + 1
        x0(k) = x0(k - 1) + hThread / 2
        y0(k) = y0(k - 1) - del
    Next i
    k = k + 1
    x0(k) = lThread
    y0(k) = 0
    
    k = k + 1
    x0(k) = 0
    y0(k) = 0

Set GrTemp = Grs.Add(gkGraphic)
GrTemp.Vertices.UseWorldCS = True
With GrTemp.Vertices
    For i = 1 To k '6
        .Add x0(i), y0(i), 0
    Next i
End With
GrTemp.Closed = True

Dim Gr5 As Graphic
Set Gr5 = Grs.Add(, "TCW40SPIN")
Gr5.Vertices.UseWorldCS = True
Gr5.Properties("Solid") = SSolid
Gr5.Properties("$ROTATIONANGLE") = 2 * Pi
Gr5.Properties("$ROTATIONCOPY") = 30
Set GrTemp = Grs.Remove(GrTemp.Index)
Gr5.Graphics.AddGraphic GrTemp
Gr5.Vertices.Add X00, Y00, 0, False, False, False, False, False
Gr5.Vertices.Add X01, Y01, 0, False, False, False, False, False

'Crown
Dim fi#, dfi#
        dfi = Pi / 2 / 20
       x0(1) = 0.8 * H
       y0(1) = 0#
       
       x0(2) = 0.8 * H
       y0(2) = 0.9 * s / 2#
       
       x0(3) = H
       y0(3) = 0.9 * s / 2#
Dim m%
        m = 3
       For i = 1 To 20
            m = m + 1
            fi = Pi / 2 - i * dfi
            x0(m) = H + 0.9 * s / 2 * Cos(fi)
            y0(m) = 0.9 * s / 2 * Sin(fi)
       Next i
       m = m + 1
       x0(m) = x0(1)
       y0(m) = y0(1)
       
       
'-----------------------------------------------------------
       
            Set GrTemp = Grs.Add(gkGraphic)
            GrTemp.Vertices.UseWorldCS = True
            With GrTemp.Vertices
                For i = 1 To m
                    .Add x0(i), y0(i), 0
                Next i
            End With
            GrTemp.Closed = True

Dim Gr6 As Graphic
            Set Gr6 = Grs.Add(, "TCW40SPIN")
            Gr6.Vertices.UseWorldCS = True
            Gr6.Properties("Solid") = SSolid
            Gr6.Properties("$ROTATIONANGLE") = 2 * Pi
            Gr6.Properties("$ROTATIONCOPY") = 30
            Set GrTemp = Grs.Remove(GrTemp.Index)
            Gr6.Graphics.AddGraphic GrTemp
            Gr6.Vertices.Add X00, Y00, 0, False, False, False, False, False
            Gr6.Vertices.Add X01, Y01, 0, False, False, False, False, False



'#################################################################
'################################################################
Dim Bool3D As Boolean3D
Dim GrRes1 As Graphic
Dim GrIndex As Long
    Set Bool3D = New Boolean3D
    Gr1.Update
    Gr2.Update
    Set GrRes1 = Bool3D.Subtract(Gr1, Gr2)
    If (Not GrRes1 Is Nothing) Then
        Gr1.Deleted = True
        Gr2.Deleted = True
        Grs.AddGraphic GrRes1
    Else
        GrIndex = Gr2.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr2
        Gr2.Cosmetic = True
        Set GrRes1 = Gr1
    End If
Dim GrRes2 As Graphic
    GrRes1.Update
    Gr3.Update
    Set GrRes2 = Bool3D.Subtract(GrRes1, Gr3)
    If (Not GrRes2 Is Nothing) Then
        GrRes1.Deleted = True
        Gr3.Deleted = True
        Grs.AddGraphic GrRes2
    Else
        GrIndex = Gr3.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr3
        Gr3.Cosmetic = True
        Set GrRes2 = GrRes1
    End If
    
Dim GrRes5 As Graphic
    GrRes2.Update
    Gr6.Update
    Set GrRes5 = Bool3D.Add(GrRes2, Gr6)
    If (Not GrRes5 Is Nothing) Then
        GrRes2.Deleted = True
        Gr6.Deleted = True
        Grs.AddGraphic GrRes5
    Else
        GrIndex = Gr6.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr6
        Gr6.Cosmetic = True
        Set GrRes5 = GrRes2
    End If
    
    
Dim GrRes3 As Graphic
    GrRes5.Update
    Gr4.Update
    Set GrRes3 = Bool3D.Subtract(GrRes5, Gr4)
    If (Not GrRes3 Is Nothing) Then
        GrRes5.Deleted = True
        Gr4.Deleted = True
        Grs.AddGraphic GrRes3
    Else
        GrIndex = Gr4.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr4
        Gr4.Cosmetic = True
        Set GrRes3 = GrRes5
    End If
    
Dim GrRes4 As Graphic
    GrRes3.Update
    Gr5.Update
    Set GrRes4 = Bool3D.Subtract(GrRes3, Gr5)
    If (Not GrRes4 Is Nothing) Then
        GrRes3.Deleted = True
        Gr5.Deleted = True
        Grs.AddGraphic GrRes4
        
        GrIndex = GrRes4.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic GrRes4
        GrRes4.Cosmetic = True
        GrRes4.Properties("PenColor") = Gr.Properties("PenColor")
 '????????????????????????????????????????????????????????????????
Dim GrLine As Graphic
        Set GrLine = Grs.Add(11)
        GrLine.Vertices.UseWorldCS = True
        With GrLine.Vertices
            .Add 0, 0, 0
            .Add H, 0, 0
        End With
        GrIndex = GrLine.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic GrLine
        GrLine.Cosmetic = True
Dim xx0#, yy0#, zz0#, xx1#, yy1#, zz1#
        GrLine.Vertices.UseWorldCS = False
        With GrLine.Vertices
            xx0 = .Item(0).X
            yy0 = .Item(0).Y
            zz0 = .Item(0).Z
            xx1 = .Item(1).X
            yy1 = .Item(1).Y
            zz1 = .Item(1).Z
        End With
         Gr.Vertices.UseWorldCS = False
        With Gr.Vertices
            X00New = .Item(0).X
            Y00New = .Item(0).Y
            Z00New = .Item(0).Z
        End With
        GrRes4.MoveRelative X00New - xx0, Y00New - yy0, Z00New - zz0 '!!!!!!!
        GrLine.Deleted = True
'????????????????????????????????????????????????????????????????
   
    Else
        GrIndex = Gr5.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr5
        Gr5.Cosmetic = True
        
        Set GrRes4 = GrRes3
        GrIndex = GrRes4.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic GrRes4
        GrRes4.Cosmetic = True
    
    End If

    Set Gr1 = Nothing
    Set Gr2 = Nothing
    Set Gr3 = Nothing
    Set Gr4 = Nothing
    Set Gr5 = Nothing
    Set Gr6 = Nothing
    Set GrRes1 = Nothing
    Set GrRes2 = Nothing
    Set GrRes3 = Nothing
    Set GrRes4 = Nothing
    Set GrRes5 = Nothing
    Set GrTemp = Nothing
    Set Grs = Nothing
    Set Bool3D = Nothing
    
Exit Sub
Failed:
End Sub


'defines the distance frof line to point in 3D space
Private Function DistPointLine(x0 As Double, y0 As Double, z0 As Double, x1 As Double, y1 As Double, z1 As Double, x2 As Double, y2 As Double, z2 As Double) As Double
    
Dim l1#, m1#, n1#
        l1 = x2 - x1
        m1 = y2 - y1
        n1 = z2 - z1
Dim t1#, t2#, t3#
        t1 = (y0 - y1) * n1 - (z0 - z1) * m1
        t2 = (z0 - z1) * l1 - (x0 - x1) * n1
        t3 = (x0 - x1) * m1 - (y0 - y1) * l1
Dim s0#, s1#, s2#
        s1 = Sqr(t1 * t1 + t2 * t2 + t3 * t3)
        s2 = Sqr(l1 * l1 + m1 * m1 + n1 * n1)
        DistPointLine = s1 / s2
End Function


